00100	C******* SUBRS  TAIL, FERMTA, REST, BREP, EXCH, SORT2, NOZERO,
00200	C******* JDRAW,CENTR,LINX,UNPACK,ROFF,NOIR, KSIG, ALPHA, SPACER
00300		SUBROUTINE TAIL(RJX,RA,RMINI)
00400		COMMON /STF/RSTFAC(8),RSTJ2
00500		COMMON /PLTR/IPLT,RHT,DIS
00600		DIMENSION ITAIL(16)
00700		DATA ITAIL/16,100090007,110012,120016,200120016,120019,100026,
00800		1 80030,20036, 40, 33, 30031, 50029,80025,100022,120016/
00900		CALL CENTER(RJY)
01000		Q=-1.
01100		IF(RA)Q=1.
01200		IF(IPLT)GO TO 2
01300		ITAIL(1)=10
01400	1	CALL JDRAW(ITAIL,RJX,RJY,RMINI,1.,Q)
01500		RETURN
01600	2	P=Q
01700		IF(RMINI.NE.RSTJ2)P=P*.6
01800		ITAIL(1)=16
01900		CALL FILLMS(12,ITAIL(5),RJX,RJY,ABS(P),P)
02000	C RA=-,STEM UP;  RA=+, STEM DOWN.
02100		GO TO 1
02200		END
02300	
02400		SUBROUTINE REST
02500		COMMON /STF/RSTFAC(8),RSTJ2/PLTR/IPLT,RHT,DIS
02600		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
02700		EQUIVALENCE(J5,JQ(3)),(R3,RJQ(1)),(R4,RJQ(2)),(R7,RJQ(5))
02800		1,(R6,RJQ(4)),(R8,RJQ(6)),(R5,RJQ(3)),(R10,RJQ(8))
02900		DIMENSION LRST(3),IRST(47),MR(2),MF(2)
03000		DATA IRST/9,100000033,160033,160030, 30,32 ,160032 ,160031,
03100		1 31,  23,100000051,100038,32,110017,200050044, 32 ,50026,
03200		1 100038,50044,100110017,70018,50017,50015,60011, 10016,
03300		1 18,  20,10022,30023, 50023, 70022,110017,
03400		1 15,100030033, 40032, 80032,120035,150039,70014,200010037,
03500		1 30039, 50039, 70037, 70035, 50033, 30033,10035/
03600		1,LRST/1,10,33/,MR/18,8/,MF/15,40/
03700	C  LRST = BEGINNING OF EACH REST, MR=FILLER WDCNT, MF=FILL START.
03800	
03900		L=J5
04000		IF(L.GT.1)L=1
04100		IF(L)L=-1
04200	C  L>3 WHEN SEVERAL TAILS ON REST
04210		R10=RSTJ2
04250		IF(ABS(R4).LT.80)GO TO 2
04260	C NEXT FOR MINI-RESTS
04270		RSTJ2=RSTJ2*.7
04280		R2=R4-100
04290		IF(R4)R2=R4+100
04295		R4=R2+2.
04300	2	CALL CENTER(CENTR)
04400		IF(J5.EQ.-2)CENTR=CENTR+9.4*R10
04450	C  CENTERS WHOLE REST
04500		CALL JDRAW(IRST(LRST(L+2)),R3,CENTR,RSTJ2,1.,1.)
04600		IF(IPLT.GE.0)GO TO 1
04700		IF(J5)GO TO 1
04800		L=L+1
04900		CALL FILLMS(MR(L),IRST(MF(L)),R3,CENTR,1.,1.)
05000	C  WHY GO THROUGH NOTWRT??
05100	1	IF(R8.EQ.0)RETURN 
05200	C  TO PUT NUM OVER REST - MULTIPLE BARS.(R8=-1 =NO NUM. OVER WHOLE RST)
05700		R4=R4+10.6
05800	C HEIGHT ??
05810		IF(IPLT)GO TO 3
05821		R6=5.96*R6
05822	C  USE PARAM 6 TO CHANGE SIZE OF CENTERING AID LINE.
05826		IF(R6.EQ.0)R6=55.
05832		CALL LINX(R3-R6,CENTR,R3+R6+16.0*RSTJ2,CENTR)
05855	C  HORIZ. LINE FOR CENTERING ON DPY ONLY.  WILL NOT PRINT!
05900	C  NEXT IS J3 
06000	3	JQ(1)=ROFF(R3+8.*RSTJ2)
06100		R5=R8
06120		R6=1.5
06160	C  NUMBER SIZE
06200		R8=0
06300	C  ↑↑↑↑↑ ALL THIS BECAUSE OF PARAM NUMS IN MAKNUM AND NOTWRT
06320		R7=0
06360	C  FOR BDR40 FONT
06400		IF(R5.GT.0)CALL MAKNUM(R5)
06500		J5=0
06600		R7=0
06650	C  ↑↑↑↑↑ NEEDED??
06700		END
06800	
06900	C  READS DATA 
07000	C  FOR SINGLE (OR DOUBLE) BAR REPEAT SIGN
07100		SUBROUTINE BREP(R3,RSTJ2)
07200		DIMENSION IREP(35)
07300		DATA IREP/35,100000015,280043,290043, 10015, 20015, 300043,310043
07400		1,30015, 40015, 320043,100020037, 30038, 40038, 50037
07500		1,50036, 40035, 30035, 20036, 20037, 50037, 20036, 40036
07600		1,100270022,280021,290021,300022,300023,290024,280024,270023
07700		1,270022, 300022, 270023, 290023/
07800		CALL CENTER(R)
07900		CALL JDRAW(IREP,R3,R,RSTJ2,1.,1.)
08000		END
08100	
08200		SUBROUTINE FERMTA(RINV)
08300		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
08400		COMMON /PLTR/IPLT,RHT,DIS
08500		COMMON /STF/RSTFAC(8),RSTJ2
08600		DIMENSION JFERM(45)
08700		EQUIVALENCE (R3,RJQ(1))
08800		DATA JFERM/24,310020003,10010010,20015,60017,110017,160015,
08900		1 190010,200003,170010,150012,120014,70014,30012,10010,
09000		1 10020003,100070007,80008,100008,110007,110006,100005,80005
09100		1 ,70006, 20,100081006, 80012,  90012,  91006, 110030002, 30008,
09200		1 70002,130008,170002, 200005, 200170002,141001,100005,130008,
09300		1 170002, 100070002, 41001, 5, 30008, 70002/
09400		IF(RINV.LT.17)GO TO 1
09500		JFERM(29)=16
09600		JFERM(35)=210005
09700		IF(RINV.NE.17)GO TO 2
09800		JFERM(29)=91006
09900		J=25
10000		GO TO 4
10100	2	JFERM(29)=16
10200	C  FOR INVERTED MORDANT
10300		J=29
10400	4	RINV=1.
10500		GO TO 3
10600	1	J=1
10700	3	CALL JDRAW(JFERM(J),R3,CENTR,RSTJ2,1.,RINV)
10800		IF(IPLT.GE.0)RETURN
10900		IF(J.EQ.1)GO TO 5
11000		J=35
11100		JFERM(35)=10
11200	5	CALL FILLMS(JFERM(J),JFERM(J+1),R3,CENTR,1.,RINV)
11300		END
11400	
11500	CC	SUBROUTINE EXCH(X,Y)
11600	CC	Z=X
11700	CC	X=Y
11800	CC	Y=Z
11900	CC	END
12000	CF	SUBROUTINE SORT2(RPOS,M)
12100	CF	DIMENSION RPOS(2,200)
12200	CF	L=2
12300	CF3	J=-1
12400	CF	RX=RPOS(1,L-1)
12500	CF	DO 2 K=L,M
12600	CF	IF(RPOS(1,K).GE.RX)GO TO 2
12700	CF	RX=RPOS(1,K)
12800	C   WHY WERE ALL THE RX'S  JX ????? 9/6/73
12900	CF	J=K
13000	CF2	CONTINUE
13100	CF	IF(J)GO TO 4
13200	CF	K=L-1
13300	CF	CALL EXCH(RPOS(1,K),RPOS(1,J))
13400	CF	CALL EXCH(RPOS(2,K),RPOS(2,J))
13500	CF4	L=L+1
13600	CF	IF(L.LE.M)GO TO 3
13700	CF	END
13800	
13900	CC	SUBROUTINE NOZERO(X)
14000	CC	IF(X.EQ.0)X=1
14100	CC	END
14200	
14300		SUBROUTINE PNUM
14400		COMMON R2,JA,CENTR,J2,R3,R4,R5,R6,RJQ(16),J3,J4,J5,J6,J7,
14500		1 J10J,IPUNC,DONT,RXX,RX,JQ(10) /STF/RSTFAC(-3/4),RSTJ2
14600		DIMENSION NUMQ(44),RNUMS(341)
14700		DATA
14800	     1 NUMQ/1,11,15,23,33,38,47,57,62,79, 89,95,108,117,125,132,138
14900	     1,150,157,164,171,177,181,187,1,192,200,212,221,234,239,246
15000	     1,250,256,261,266,  271,282,285,293,298,314,330,335/
15100	      DATA (RNUMS(K),K=1,131)/10.0,1003.107, 6.102, 6.01, 3.015,
15200	     1 104.015, 107.01,107.102, 104.107, 3.107,
15300	     1 14.0, 1105.011, 101.015, 101.107, 22.0,
15400	     1 1106.011, 102.015, 3.015, 7.011, 7.005, 107.107, 7.107, 32.0,
15500	     1 1107.015, 7.015, 101.007, 3.007, 7.003, 7.102, 3.107, 103.107,
15600	     1 107.103, 37.0, 1007.102, 107.102, 2.015, 2.107, 46.0, 1107.107,
15700	     1 4.103, 7.0, 7.004, 2.006, 107.004, 107.015, 7.015, 56.0,
15800	     1 1004.015, 107.0, 107.103, 103.107, 4.107, 7.103, 7.0, 3.003,
15900	     1 104.003, 61.0, 1107.011, 107.015, 7.015, 107.107, 78.0, 1003.004,
16000	     1 7.0, 7.103, 4.107, 104.107, 107.103, 107.0, 103.004, 3.004,
16100	     1 6.008, 6.012, 2.015, 102.015, 106.012, 106.008, 103.004,
16200	     1 88.0, 1104.107, 7.008, 7.011, 4.015, 104.015, 107.011, 107.008,
16300	     1 103.005, 4.005, 94.0, 1106.107, 0.015,6.107,1004.101,104.101,
16400	     1 107.0, 1106.107, 106.015, 3.015, 6.012, 6.007, 3.004, 1106.004,
16500	     1 2.004, 6.001, 6.104, 3.107, 106.107, 116.0, 1006.104, 3.107,
16600	     1 103.107, 106.104, 106.011, 103.015, 3.015, 6.011, 124.0,
16700	     1 1106.107, 106.015, 3.015, 6.011, 6.103, 3.107, 106.107,
16800	     1 131.0, 1006.107, 106.107, 106.015, 6.015, 1003.005, 106.005/
16900	C   THE NEXT IS FOR 'F' TO 'P'
17000	C   1 NUM NOT NEEDED IN 'G'  ALSO IN RNOTE (1/2 NOTE).
17100	      DATA (RNUMS(K),K=132,199)/
17200	     1 137.0, 1106.107, 106.015, 6.015, 1003.005, 106.005, 149.0, 
17300	     1 1001.102, 6.102, 6.104, 6.104, 3.107, 103.107, 106.104, 
17400	     1 106.011, 103.015, 3.015, 6.011, 156.0, 1106.107, 106.015,
17500	     1 1006.015, 6.107, 1006.005, 106.005, 163.0, 1106.107, 0.107,
17600	     1 1103.107, 103.015, 1106.015, 0.015,
17700	     1 170.0, 1110.102, 110.105, 108.107, 103.107, 101.105, 101.015, 
17800	     1 176.0, 1106.107, 106.015, 1006.015, 106.005, 6.107, 180.0,
17900	     1 1006.107, 106.107, 106.015, 186.0, 1106.107, 106.015, 1.004,
18000	     1 8.015, 8.107, 191.0, 1106.107, 106.015, 6.107, 6.015, 199.0
18100	     1, 1106.107, 106.015, 3.015, 6.012, 6.007, 3.004, 106.004/ 
18200	C   'Q' TO ')'
18300	      DATA(RNUMS(K),K=200,341)/
18400	     1 211.0, 1003.107, 6.102, 6.01, 3.015, 103.015, 106.01, 106.102,
18500	     1 103.107, 3.107, 1001.001, 7.108, 220.0, 1106.107, 106.015,
18600	     1 3.015, 6.012, 6.007, 3.004, 106.004, 6.107, 233.0, 1106.104,
18700	     1 103.107, 3.107, 6.104, 6.001, 3.004, 103.004, 106.007, 106.011,
18800	     1 103.015, 3.015, 6.01, 238.0, 1106.015, 7.015, 1000.015, 0.107,
18900	     1 245.0, 1106.015, 106.104, 103.107, 3.107, 6.104, 6.015, 249.0,
19000	     1 1106.015, 0.107, 6.015, 255.0, 1106.015, 103.107, 1.005, 5.107,
19100	     1 8.015, 260.0, 1106.015, 6.107, 1106.107, 6.015, 265.0, 1106.015,
19200	     1 0.003, 1106.107, 6.015, 270.0, 1106.015, 6.015, 106.107, 6.107,
19300	     1 281.0, 1105.102, 105.105,103.105,104.102,104.105,105.102,103.102,
19400	     1103.108, 106.112, 1106.112, 284., 1110.003, 2.003, 292., 1105.102,
19500	     1 105.105,104.102,104.105,103.102,103.105,105.102,297.0,1110.007,
19600	     1 2.007, 1110.0, 2.0, 313.0, 1101.015, 103.013, 105.010,
19700	     1 106.006,106.002,105.102,103.105,101.107, 103.104,104.102,105.002
19800	     1 ,105.006,104.01,103.012,101.015, 329.0,1107.015,105.013,
19900	     1 103.01 ,102.006,102.002,103.102,105.105,107.107, 105.104,104.102
20000	     1 ,103.002,103.006,104.01,105.012,107.015,  334.0,1110.003,
20100	     1 2.003, 1104.009, 104.103,  341.0,1110.004, 2.004, 1101.009,
20200	     1 107.101, 1101.101, 107.009/
20300	C  3RD ITEM IN 19400 NOT NEEDED 12/73
20400	C  1-10=NUMS 0-9, 11-36=ALPHA, 37-42=SIGNS
20500	
20600		CALL CENTX
20700		J10J=J5
20800		CALL NOZERO(R6)
20900		SIZ=R6*RSTJ2
21000		IPUNC=0
21100		IF(J10J.LT.44)GO TO 451
21200		IPUNC=J10J
21300		IF(J10J.EQ.44)J10J=38
21400		IF(J10J.GE.45)J10J=36
21500		IF(J5.NE.46)GO TO 451
21600		RXX=4
21700		CALL RJBX(-RXX)
21800		RX=16
21900		CENTR=CENTR+RX*SIZ
22000	451	IX=NUMQ(J10J+1)
22100	C  IX=END # OF ITEM
22200	C  IX+1=1ST PART OF ITEM
22300	      CALL RDRAW(IX+1,RNUMS(IX),RNUMS,SIZ,R3,CENTR+RSTJ2*3.,SIZ)
22400		IF(IPUNC.EQ.0)RETURN
22500		IF(IPUNC.NE.46)GO TO 351
22600		CALL RJBX(SIZ*2.*RXX)
22700	C  FOR "
22800	651	IPUNC=0
22900		GO TO 451
23000	351	RXX=11
23100	C FOR : AND ;
23200		CENTR=CENTR+RXX*SIZ
23300		J10J=38
23400		GO TO 651
23500		END
     

00100	C****** FOR LISTS OF LETTERS, ETC. AND TRILL *******
00200		SUBROUTINE ALPHA
00300		COMMON /PLTR/IPLT,RHT,DIS /FONT/JFONT
00400		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
00500	       EQUIVALENCE(J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R5,RJQ(3)),
00600		1(R8,RJQ(6)),(NRJ,RJQ(8)),(JX,JQ(11)),(RSX,JQ(12)),
00700		1(R6,RJQ(4)),(J7,JQ(5)),(J8,JQ(6)),(J9,JQ(7)),(J10,JQ(8))
00800		1,(J6,JQ(4)),(R7,RJQ(5)),(R4,RJQ(2)),(IFNT,JQ(13)),
00900		1(NR,JQ(14)),(RSP,JQ(15)),(RY,JQ(16)),(RX,JQ(17)),(RZ,JQ(18)),(RW
01000		1,JQ(19)),(RB,JQ(20)),(R,RJQ(20)),(FILL,RJQ(19)),(R9,RJQ(7))
01100		1,(JTR,RJQ(17)),(RF,RJQ(15)),(JR3,RJQ(14)),(R3,RJQ(1))
01110		1,(R10,RJQ(8))
01200		COMMON/STF/RSTFAC(8),RSTJ2 /POSI/STFF(8),JJ2,POS
01300		DATA R4X/-2.1/,IFNT/1/, NR/'PRIM0'/
01400	
01500		IF(JA.EQ.7)GO TO 20
01600		JTR=99
01650		IF(R5.GE.100)R5=R5-100
01675	C >100 FOR TEXT IN ORCH SCORES FOR ALL SEP. PARTS.
01700	C  PRIMITIVE IS DEFAULT FONT.  #=SET BACK TO PRIM.
01800	C ONLY 11 LETTERS WITHOUT FONT RESET.
01900	54	R=19.7*R5*RSTJ2
02000		RB=J3
02100		RW=R4
02200		J9=0
02300	C J9=0 AVOIDS ROTATION IN 'CLEFS'
02400		DO 50 KA=4,6
02410		NXZ=-1
02420		RZ=RJQ(KA)
02440	CC	JY=RZ
02460	CC	IF(JY.NE.RZ)GO TO 130
02461	CC	IF(JY.EQ.RZ)GO TO 13
02462	C  WILL LOSE ON "0AB0" IN OLD FILES**************
02465	CC	IF(JY.GT.999999)GO TO 13
02470	CC130	RZ=100.*RZ
02480	C  FOR OLD FORMAT OF CODE 16
02500	13	JY=RZ+.2
02600		JX=1000000
02700		DO 53 LA=1,4
02800		J5=JY/JX
02900		J5X=J5
03000		R3=J3
03100		IF(J5.EQ.99)GO TO 55
03110	73	IF(KFNT)IFNT=1
03115	C READS OLD SYS. AND NEW AUTOMATIC LWR CASE.
03120		IF(J5.LT.70)GO TO 72
03125		KFNT=-1
03127	C  SETS AUTOMATIC LOWER CASE FLAG.
03130		IFNT=-1
03140	C  60 ADDED FOR LOWER CASE LETTERS.
03150		J5=J5-60
03200	C NO MORE IN THIS WD.
03300	72	IF(J5.LT.50)GO TO 1
03400		GO TO(2,3,9,4,5),J5-49
03500	C SWITCHES FOR DIFF. FONTS.(55 MAKES ')48=UPR,49=LWR,50=BDR,51=BDI,52=PRM
03550	C  ********* UPPER AND LOWER NUMBERS(48,49) NO LONGER NEEDED.(SEE 73 ↑)
03560		IF(J5.GT.55)GO TO 10
03600		J5=36
03700		R4=R4+2.9
03800	C  55 WILL MAKE ' --- 56=?  57=! (THEY COME AFTER y z IN BDR46)
03900		GO TO 1
03910	10	J5=J5+6 
03920		NRX=NR
03925		NXZ=0 
03930		NR='BDR40'
03940		NJF=JFONT
03950		JFONT=-1
03960		GO TO 1
04000	2	NR='BDR40'
04100	C  &=NON-ITALICS  --  JFONT IS TEMPORARY SWITCH  5/74
04200		IF(JFONT)GO TO 9
04300		GO TO 11
04400	CC	GO TO 8
04500	3	NR='BDI40'
04600	C  @=51=ITALICS
04700		IF(JFONT)GO TO 9
04800	C  TYPE '44 -1' TO MAKE ALL FONTS INTO 'PRIM'
04900	CC8	IF(IFNT.EQ.0)IFNT=-1
05000		GO TO 11
05100	4	FILL=-2
05200		GO TO 11
05300	5	FILL=0
05400		GO TO 11
05500	9	NR='PRIM0'
05600		GO TO 11
05700	1	CALL SPACER(J5,IFNT,RB,R)
05710		IF(J5.GT.60)GO TO 71
05720	C  NOW 62=?  63=!  IN BDR46
05800		IF(J5-47)7,6,11
05900	7	IF(JFONT.NE.0)GO TO 77
06000		IF(IPLT.GE.0)GO TO 30
06100	C  JFONT=0 FOR FIXED WIDTH OF FONTS.  = AND ONLY DPYS PRIMITIVE.
06200	CC	J5=J6
06300	CC	IF(IFNT.EQ.0)GO TO 30
06400	77	IF(J5.GE.36)GO TO 30
06500	C  PUNCTUATION AND SPACE.
06600		IF(NR.NE.'PRIM0')GO TO 70
06700		IF(IFNT.EQ.1)GO TO 30
06800		IF(J5.LT.10)GO TO 30
06900	C  JUMP TO USE UPPER CASE PRIM. LOWER CASE STARTS IN PRIM1.
07000		GO TO 71
07100	70	IF(J5.LE.9)GO TO 71
07200		IF(IFNT)J5=J5+26
07300	71	RX=R6
07400		R6=R5*.28
07500	C  .29 IS SIZE FACTOR -- PERHAPS CHANGE SIZE IN FONT TO =1.
07600		RY=R7
07700		R7=R6
07800		RZ=R8
07900		R4=R4+R4X
08000	C  SHIFTS DOWN ??? WHY NOT GET RID OF THIS.??
08100		R8=FILL
08200		NRJ=NR
08300	C  GETS RIGHT FILE
08400		JA=12
08450	C  ANY NON-11 NUMBER .GT.10 WILL DO.
08500	CC	R2=J2
08600		CALL CLEFS
08700		R6=RX
08800		R7=RY
08900		R8=RZ
09000	C  PUTS BACK RIGHT STUFF
09100		IF(NXZ)GO TO 6	
09110		NR=NRX
09120		JFONT=NJF
09130		GO TO 6
09200	
09300	30	J7=0
09400		R6=R5
09500		CALL PNUM
09600	C  47=BLANK  (WAS 99)
09700	6	J3=ROFF(RB)
09800		R4=RW
09900	11	JY=JY-J5X*JX
10000	C TO GET NEXT NUM OUT OF JY
10100	53	JX=JX/100
10200	50	CONTINUE
10300	55	IF(JTR.EQ.99)GO TO 100
10400		GO TO 52
10500	
10510	
10520	C  FOR TRILLS
10530	C  7, POS1, STF, NT#, SIZE, POS2, X     IF X=1 THEN NO WAVEY LINE
10535	20	RF=R6
10540		IF(J7.LE.1)GO TO 200
10550	C  NEXT FOR SPECIAL PEDAL MARKS.
10560	
10565	C PEDAL: 7,STF,POS,0=STND POS,NNN=PEDS,POS2,BRACK #S,LFT POS BRK.
10567	C P5=101 MEANS LFT & RT PEDS., P7=2 NO BRK, =3 --!, =4 ----
10575		RW=R8
10580		RB=R3
10585		NR=J7
10590		JY=J5
10595		CALL NOZERO(R9)
10597		RY=R9
10598		RX=23.84*R9*RSTJ2
10600		R6=.45*RY
10605		J9=0
10610		J5=17
10615	C  IN FILE CLEF1.DMD
10620		JA=3
10650		R5=0
10660		R7=0
10662		R4=R4-6
10663	C  STANDARD POS IS AT -6 ******  (I.E. P4=0 PUTS TOP OF IT AT -6)
10664		CALL CLEFS
10665		IF(JY.EQ.0)GO TO 222
10668		R8=-1
10669		J5=18
10670		IF(JY.LT.100)GO TO 203
10680		JY=JY-100
10700		CALL CLEFS
10710	203	R3=RB+RX
10730		IF(JY.LT.10)GO TO 204
10750		JY=JY-10
10760		CALL CLEFS
10770	204	R3=RB+RX+RX
10790		IF(JY.NE.0)CALL CLEFS
10810	C PRINTS THE 3 BOTTOM ITEMS
10820	
10915	222	IF(NR.EQ.2)RETURN
10920		IF(RW.NE.0)R3=RB-5.96*RW
10930	C  FOR BRACKET
10935		RX=POS
10940		R6=RF
10950		R4=R4+3.
10955		R5=R4
10960		J7=0
10970		R7=0
10980		R8=0
10985		R10=0
10990	206	CALL ITMSUB
11000		IF(NR.EQ.4)RETURN
11002	C  R7=4= NO END ON BRKT.
11005		POS=RX
11006	C  POS GOT RUINED IN ITMSUB.
11010		R3=ROFF(RHORZ(RF))
11020		R5=R5+1.4*RY
11030		CALL ITMSUB
11040		RETURN
11045	
11050	200	CALL NOZERO(R5)
11075		R10=R5
11100		R5=.8*R5
11200		J3=J3+6*RSTJ2
11400		JR3=J3
11500		R6=51898799.0
11600	C  @tr  LWR CASE, ITAL.  TR
11700		R7=99999999.0
11800		R8=R7
11900		JTR=J7
12000		GO TO 54
12100	52	IF(JTR.NE.0)GO TO 100
12200	C   GO TO 100 IF NO WAVY LINE IS NEEDED
12300		R3=JR3+20.*RSTJ2*R10
12400		JA=4
12500		J7=-2
12600	C  J7 IS SWITCH TO DRAW WIGGLE
12700		R6=RF
12800		R9=.7*R10
12850	C  SETS WIGGLE HEIGHT
12900		R8=.9*R10
13000	C  R10 IS SIZE (P5)
13100		J10=0
13200		IF(IPLT)J10=1
13300		CALL ITMSUB
13400	C  SINGLE WIGGLE ON DPY, DOUBLE ON PLOTTER.
13450	100	IF(KFNT)IFNT=1
13475		KFNT=0
13500		END
13600	
13700	
13800		SUBROUTINE SPACER(J5,IFNT,RB,R)
13900	C  SPACES ALPHABET ITEMS.
14000		DATA RS/1.08/,RSPC/1./,RLWR/.96/
14100	C  JUMP TO USE PRIMITIVE ALPHABET.
14200		IF(J5.GT.47)GO TO 10
14300		IF(J5.LE.9)GO TO 177
14400		IF(J5.LT.36)GO TO 10
14500	C NEXT FOR NUMBERS, SPACE AND PUNCTUATION.
14600	177	RSX=RSPC
14700		IF(IFNT)RSX=.9
14800		GO TO 3
14900	10	IF(J5.LT.47)GO TO 5
15000		IF(J5.EQ.52)GO TO 14
15100		IF(J5.EQ.48)IFNT=1
15200		IF(J5.EQ.49)IFNT=-1
15210	C  ABOVE 2 NO LONGER NEEDED.
15300		IF(J5.GE.55)GO TO 5
15400	C  PUNCT. WILL EXPAND ABOVE 54.
15500		RETURN
15600	14	IFNT=0
15700	C  #=52=PRIMITIVE
15800		JA=10
15900		RETURN
16000	5	RSX=RS
16100		IF(IFNT)RSX=RLWR
16200	C  FOR LOWER CASE SPACING.  (96%)
16300		IF(J5.EQ.22)GO TO 277
16400		IF(J5.NE.32)GO TO 3
16500	277	RSX=RSX*1.12
16600	C  FOR M AND W
16700	3	IF(J5.GE.36)GO TO 21
16800		IF(J5.EQ.1)GO TO 21
16900		IF(J5.EQ.18)GO TO 21
17000		IF(J5.EQ.19)GO TO 21
17100	C  FOR 1,I AND J
17200		IF(IFNT.GE.0)GO TO 4
17300	C  NEXT FOR LOWER CASE ONLY.
17400		IF(J5.EQ.15)GO TO 21
17500		IF(J5.EQ.19)GO TO 21
17600		IF(J5.EQ.21)GO TO 21
17700		IF(J5.NE.29)GO TO 4
17800	21	IF(J5.NE.47)RSX=RSX*.68
17900	C  FOR F,I,J,L,T
18000	4	RB=RB+R*RSX
18100		END
18200	
18300	
18400	CC	SUBROUTINE JDRAW(M,R3,CENTR,RSTJ2,RX,RY)
18500	CC	COMMON/LL/LL
18600	CC	DIMENSION M(1)
18700	CC	RC=RX*RSTJ2
18800	CC	RD=RY*RSTJ2
18900	CC	DO 2 K=2,M(1)
19000	CC	CALL UNPACK(IA,IB,M(K))
19100	CC2	CALL LINES(FLOAT(IA)*RC+R3,FLOAT(IB)*RD+CENTR,LL)
19200	CC	END
19300	
19400	CC	SUBROUTINE CENTER(CNTR)
19500	C  TO CENTER ITEMS CREATED WITH DRAWING PROG.
19600	CC	COMMON /STF/RSTFAC(8),RSTJ2
19700	CC	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
19900	CC	EQUIVALENCE (R4,RJQ(2))
20000	CC	CNTR=POS+(2+AMOD(R4,100.)*7)*RSTJ2
20100	CC	END
20200	
20300	CC	SUBROUTINE LINX(A,B,C,D)
20400	C  SAVES SPACE FOR SINGLE LINES.
20500	CC	CALL LINES(A,B,3)
20600	CC	CALL LINES(C,D,2)
20700	CC	END
20800	
20900	CC	SUBROUTINE UNPACK(M,N,I)
21000	CC	COMMON/LL/L
21100	C  L IS FOR VIS. OR INVIS. LINES.
21200	CC	N=I
21300	CC	L=2
21400	CC	M=N/100000000
21500	CC	IF(M.EQ.0)GO TO 2
21600	CC	L=3
21700	CC	N=N-100000000*M
21800	CC2	M=N/10000
21900	CC	N=MOD(N,10000)
22000	CC	IF(M.GT.1000)M=1000-M
22100	CC	IF(N.GT.1000)N=1000-N
22200	CC	END
22300	
22400	CC	FUNCTION ROFF(R)
22500	CC	S=.5
22600	CC	IF(R)S=-S
22700	CC	ROFF=R+S
22800	CC	RETURN
22900	CC	END
23000	
23100	
23200	C**************  NOIR, RJBX, CENTX ***************
23300	CF	SUBROUTINE NOIR(RMINI)
23400	C  BLACKS IN NOTES
23500	CF    COMMON R2,JA,CENTR,J2,RJQ(20),JQ(12),B,C,KC,D,N,JY,M,L
23600	CF	COMMON/PLTR/IPLT,RHT,DIS /XRN/IRN(4000)
23700	CF	EQUIVALENCE (PRE,IRN(1))
23800	CF	DATA BL/7.5/,BH/6.7/
23900	C  ADJUST BH AND FL FOR HEIGHT OF NOTE AND 'WIDTH'
24000	CF	IPOS=ROFF(RJQ(1)*DIS)
24100	CCCF	IF(RMINI.LT..9)IPOS=IPOS+1
24200	CF	JPOS=ROFF(CENTR*RHT)
24300	CF	IF(-RMINI.EQ.PRE)GO TO 10
24400	CF	PRE=-RMINI
24500	CCCF	D=.25*RMINI
24600	CF	D=.25
24700	CF	B=BH*RMINI*RHT
24800	CF	E=RMINI*DIS
24900	CF	A=BL*E
25000	CF	IC=A
25100	CF	A=A*A
25200	CF	E=-B/4.
25300	CF	K=B
25400	CF	B=B*B
25500	C  USES EQUATION FOR ELLIPSE
25600	CF	N=1
25700	CF	NX=2
25800	CF6	DO 1 J=-K,K
25900	CF	Y=J*J
26000	CF	X=SQRT(A-(A*Y)/B)
26100	CF	L=E-X
26200	CF	M=X+E
26300	C  THE TWO SIDES OF THE LINE
26400	CF	IF(N)CALL EXCH(L,M)
26500	CF	IRN(NX)=L
26600	CF	IRN(NX+1)=M
26700	C     C IS VERTICLE POS.
26800	CF	NX=NX+2
26900	CF	E=E+D
27000	C   E IS TO TILT IT.
27100	CF1	N=-N
27200	CF10	CALL PLOT(IPOS+3,JPOS,3)
27300	CF	N=2
27400	C   1ST LOC. OF ARRAY HAS "PRE"
27500	CF	L=IPOS+IC
27600	CF	DO 11 M=-K,K
27700	CF	J=M+JPOS
27800	CF	CALL PLOT(L+IRN(N),J,2)
27900	CF	CALL PLOT(L+IRN(N+1),J,2)
28000	CF11	N=N+2
28100	CF	END
28200	
28300	CC	SUBROUTINE RJBX(R)
28400	CC     COMMON Q(4),R3,RJQ(39)/STF/RSTFAC(8),RSTJ2
28500	CC	R3=R3+R*RSTJ2
28600	CC	END
28700	
28800	CC	SUBROUTINE CENTX
28900	CC     COMMON A,B,CENTR,D,E,R4,R(38) /STF/RSTFAC(8),RSTJ2
29000	CC	1 /POSI/STFF(8),JJ2,POS
29100	CC	CENTR=POS-18.*RSTJ2+AMOD(R4,100.0)*RSTJ2*7.
29200	CC	END
29300	C******** THE ABOVE ARE NOW IN SMALL.FAI (3/75)
29400	
29500	C****** 7, STF, POS, HGT, NUM OF SHARPS OR FLATS(+ OR -), CLEF
29600	C		      (	CLEF = TREB,0  BASS,1  ALT,2  TEN,3 )
29700		SUBROUTINE KSIG
29800	C   FOR KEY SIGNATURES AND ACCENTS, ETC. (IN 'SCORE')
29900	      COMMON R2,JA,CENTR,J2,RJQ(20),JQ(17),T,S,Z/STF/RSTFAC(-3/4),RSTJ2
30000		EQUIVALENCE (R4,RJQ(2)),(J4,JQ(2)),(J5,JQ(3)),(J6,JQ(4))
30100		1,(R6,RJQ(4))
30200	
30300		JA=9
30400	C  USES THIS KEY NUM IN NOTWRT
30500	C   COUNTER
30600		IZ=IABS(J5)
30700	C  NUMBER OF CALLS ON NOTWRT
30800	C  THE CLEF NUM.  IT GETS WIPED OUT IN NOTWRT.
30900		JW=1
31000		R6=0
31100		IF(J5.GT.0)JW=2
31200	C   THE CODE FOR FLAT OR SHARP
31250		IF(IZ.LT.100)GO TO 5333
31262		JW=3
31268		IZ=IZ-100
31275	C WILL MAKE NATURALS IF 100 IS ADDED OR SUBTRACTED.
31300	5333	CLEF=-(J6+1)
31400	C CLEF #S ARE CHNGD TO -1,-2,-3,-4 (TREB.,BA.,ALT.,TEN.)
31500	C  CLEF NOW SET IN MAIN PROG.
31600	C  IF NO CLEF GIVEN, TREBLE IS USED.
31700		T=10.
31800		IF(CLEF.LT.-2.)T=11.
31900		S=CLEF+4.
32000		IF(CLEF.EQ.-4)S=-1.
32100		IF(J5.LT.0)GO TO 253
32200		W=-3.
32300		YY=4.
32400		Z=11.
32500	C  SHARPS
32600		GO TO 353
32700	253	W=3.
32800		YY=-4.
32900		Z=7.
33000	C  FLATS
33100	353	N=1
33200		Z=Z+R4
33300		RX=JQ(1)
33400		RA=0
33500	C   RA IS AMOUNT TO BE ADDED TO ORIGINAL POS.
33600		DO 553 KA=1,IZ
33700		J5=JW
33800		RJQ(1)=RX+RA
33900		RA=RA+13.*RSTJ2
34000	C  MOVES OVER FOR NEXT ACCI.
34100		RD=Z
34200		R4=Z
34300		IF(CLEF.NE.-1.)GO TO 7
34400		IF(R4.GT.12.)R4=R4-7.
34500		GO TO 9
34600	7	R4=R4-S
34700		IF(R4.GT.T)R4=R4-7.
34800	C  ABOVE ARRANGES VERT. POS OF ACCIS.
34900	9	J4=R4
35000	C  FOR VERT. POS. IN 'DRWNT' (WHEN PLOTTING.)
35100		CALL CENTX
35200		CALL NOTWRT
35300		Z=RD+W
35400		IF(N)Z=RD+YY
35500	553	N=-N
35600		END